home *** CD-ROM | disk | FTP | other *** search
/ Shareware Super Platinum 8 / Shareware Super Platinum 8.iso / mac / WIN_PRO / DS-1.ZIP;1 / RUNTIME.ZIP / FMATH.R < prev    next >
Encoding:
Text File  |  1992-02-10  |  2.9 KB  |  129 lines
  1. /*
  2.  * fmath.r -- sin, cos, tan, acos, asin, atan, dtor, rtod, exp, log, sqrt
  3.  */
  4.  
  5. #ifdef MathFncs
  6.  
  7. #ifndef PI
  8. #define PI 3.141592653589793
  9. #endif                    /* PI */
  10.  
  11. /*
  12.  * Most of the math ops are simple calls to underlying C functions,
  13.  * sometimes with additional error checking to avoid and/or detect
  14.  * various C runtime errors.
  15.  */
  16. #begdef MathOp(funcname,ccode,comment,pre,post)
  17. #funcname "(r)" comment
  18. function{1} funcname(x)
  19.  
  20.    if !cnv:C_double(x) then
  21.       runerr(102, x)
  22.  
  23.    abstract {
  24.       return real
  25.       }
  26.    inline {
  27.       double y;
  28.       pre        /* Pre math-operation range checking */
  29.       errno = 0;
  30.       y = ccode(x);
  31.       post        /* Post math-operation C library error detection */
  32.       return C_double y;
  33.       }
  34. end
  35. #enddef
  36.  
  37.  
  38. #define aroundone if (x < -1.0 || x > 1.0) {drunerr(205, x); errorfail;}
  39. #define positive  if (x < 0)               {drunerr(205, x); errorfail;}
  40.  
  41. #define erange    if (errno == ERANGE)     runerr(204);
  42. #define edom      if (errno == EDOM)       runerr(205);
  43.  
  44. MathOp(sin, sin,  ", x in radians.", ;, ;)
  45. MathOp(cos, cos,  ", x in radians.", ;, ;)
  46. MathOp(tan, tan,  ", x in radians.", ; , erange)
  47. MathOp(acos,acos, ", x in radians.", aroundone, edom)
  48. MathOp(asin,asin, ", x in radians.", aroundone, edom)
  49. MathOp(exp, exp,  " - e^x.", ; , erange)
  50. MathOp(sqrt,sqrt, " - square root of x.", positive, edom)
  51. #define DTOR(x) ((x) * PI / 180)
  52. #define RTOD(x) ((x) * 180 / PI)
  53. MathOp(dtor,DTOR, " - convert x from degrees to radians.", ; , ;)
  54. MathOp(rtod,RTOD, " - convert x from radians to degrees.", ; , ;)
  55.  
  56.  
  57.  
  58. "atan(r1,r2) -- r1, r2  in radians; if r2 is present, produces atan2(r1,r2)."
  59.  
  60. function{1} atan(x,y)
  61.  
  62.    if !cnv:C_double(x) then
  63.       runerr(102, x)
  64.  
  65.    abstract {
  66.       return real
  67.       }
  68.    if is:null(y) then
  69.       inline {
  70.          return C_double atan(x);
  71.          }
  72.    if !cnv:C_double(y) then
  73.       runerr(102, y)
  74.    inline {
  75.  
  76. #if AMIGA
  77. #if AZTEC_C
  78.    #define atan2(x,y) atan(x/y)
  79. #endif                    /* AZTEC_C */
  80. #endif                    /* AMIGA */
  81.    
  82.       return C_double atan2(x,y);
  83.       }
  84. end
  85.  
  86.  
  87. "log(r1,r2) - logarithm of r1 to base r2."
  88.  
  89. function{1} log(x,b)
  90.  
  91.    if !cnv:C_double(x) then
  92.       runerr(102, x)
  93.  
  94.    abstract {
  95.       return real
  96.       }
  97.    inline {
  98.       if (x <= 0.0) {
  99.          drunerr(205, x);
  100.          errorfail;
  101.          }
  102.       }
  103.    if is:null(b) then
  104.       inline {
  105.          return C_double log(x);
  106.          }
  107.    else {
  108.       if !cnv:C_double(b) then
  109.          runerr(102, b)
  110.       body {
  111.          static double lastbase = 0.0;
  112.          static double divisor;
  113.  
  114.          if (b <= 1.0) {
  115.             drunerr(205, b);
  116.             errorfail;
  117.             }
  118.          if (b != lastbase) {
  119.             divisor = log(b);
  120.             lastbase = b;
  121.             }
  122.      x = log(x) / divisor;
  123.          return C_double x;
  124.          }  
  125.       }
  126. end
  127.  
  128. #endif                    /* MathFuncs */
  129.